home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Languguage OS 2
/
Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO
/
language
/
ici
/
ici.cpi
/
parse.c
< prev
next >
Wrap
C/C++ Source or Header
|
1994-10-27
|
36KB
|
1,767 lines
#include "parse.h"
#include "func.h"
#include "str.h"
#include "struct.h"
#include "buf.h"
#include "file.h"
#include "op.h"
#include "exec.h"
static char not_by[] = "not followed by";
static char an_expression[] = "an expression";
STATIC string_t *string_array;
STATIC string_t *string_set;
STATIC string_t *string_struct;
STATIC string_t *string_func;
STATIC string_t *string_NULL;
STATIC string_t *string_in;
STATIC string_t *string_onerror;
STATIC string_t *string_else;
STATIC string_t *string_auto;
STATIC string_t *string_break;
STATIC string_t *string_case;
STATIC string_t *string_continue;
STATIC string_t *string_default;
STATIC string_t *string_do;
STATIC string_t *string_extern;
STATIC string_t *string_for;
STATIC string_t *string_forall;
STATIC string_t *string_if;
STATIC string_t *string_return;
STATIC string_t *string_static;
STATIC string_t *string_switch;
STATIC string_t *string_while;
STATIC string_t *string_try;
/*
* A few forward definitions...
*/
STATIC int compound_statement();
STATIC int expr();
STATIC int const_expression();
STATIC int statement();
/*
* In general, parseing functions return -1 on error (and set the global
* error string), 0 if they encountered an early head symbol conflict (and
* the parse stream has not been disturbed), and 1 if they actually got
* what they were looking for.
*/
#define this p->p_got.t_what
#ifndef SMALL
#define next(p, a) (p->p_ungot.t_what != T_NONE \
? (p->p_got=p->p_ungot, p->p_ungot.t_what=T_NONE, this) \
: lex(p, a))
#define reject(p) (p->p_ungot = p->p_got)
#else
STATIC int
next(p, a)
parse_t *p;
array_t *a;
{
if (p->p_ungot.t_what != T_NONE)
{
p->p_got = p->p_ungot;
p->p_ungot.t_what = T_NONE;
return this;
}
return lex(p, a);
}
STATIC void
reject(p)
parse_t *p;
{
p->p_ungot = p->p_got;
}
#endif
int
init_parse()
{
#define STRING(x) if (need_string(&string_ ## x, #x)) return 1
STRING(array);
STRING(set);
STRING(struct);
STRING(func);
STRING(NULL);
STRING(in);
STRING(onerror);
STRING(else);
STRING(auto);
STRING(break);
STRING(case);
STRING(continue);
STRING(default);
STRING(do);
STRING(extern);
STRING(for);
STRING(forall);
STRING(if);
STRING(return);
STRING(static);
STRING(switch);
STRING(while);
STRING(try);
#undef STRING
return 0;
}
STATIC int
not_followed_by(a, b)
char *a;
char *b;
{
sprintf(buf, "\"%s\" %s %s", a, not_by, b);
error = buf;
return -1;
}
/*
* Returns a non-loose array of identifiers parsed from a comma seperated
* list, or NULL on error. The array may be empty.
*/
STATIC array_t *
ident_list(p)
parse_t *p;
{
array_t *a;
a = new_array();
for (;;)
{
if (next(p, NULL) != T_NAME)
{
reject(p);
return a;
}
if (pushcheck(a, 1))
goto fail;
*a->a_top = p->p_got.t_obj;
loose(*a->a_top);
++a->a_top;
if (next(p, NULL) != T_COMMA)
{
reject(p);
return a;
}
}
fail:
loose(a);
return NULL;
}
/*
* Return -1, 0 or 1, usual conventions. On success, returns a parsed
* non-loose function in parse.p_got.t_obj.
*/
STATIC int
function(p, name)
parse_t *p;
string_t *name;
{
array_t *a;
func_t *f;
func_t *saved_func;
object_t **fp;
a = NULL;
f = NULL;
if (next(p, NULL) != T_ONROUND)
{
reject(p);
return 0;
}
if ((a = ident_list(p)) == NULL)
return -1;
saved_func = p->p_func;
if (next(p, NULL) != T_OFFROUND)
{
not_followed_by("ident ( [args]", "\")\"");
goto fail;
}
if ((f = new_func()) == NULL)
goto fail;
if ((f->f_autos = new_struct()) == NULL)
goto fail;
loose(f->f_autos);
for (fp = a->a_base; fp < a->a_top; ++fp)
{
if (assign(f->f_autos, *fp, objof(&o_null)))
goto fail;
}
f->f_autos->s_super = structof(v_top[-1])->s_super;
p->p_func = f;
f->f_args = a;
loose(a);
a = NULL;
f->f_name = name;
if (pushcheck(f->f_args, 1))
goto fail;
switch (compound_statement(p, NULL))
{
case 0: not_followed_by("ident ( [args] )", "\"{\"");
case -1: goto fail;
}
f->f_code = arrayof(p->p_got.t_obj);
loose(f->f_code);
if (pushcheck(f->f_code, 2))
goto fail;
*f->f_code->a_top++ = objof(&o_null);
*f->f_code->a_top++ = objof(&o_return);
f->f_code = arrayof(atom(objof(f->f_code), 1));
f->f_args = arrayof(atom(objof(f->f_args), 1));
f->f_autos = structof(atom(objof(f->f_autos), 1));
p->p_got.t_obj = atom(objof(f), 1);
p->p_func = saved_func;
return 1;
fail:
if (a != NULL)
loose(a);
if (f != NULL)
loose(f);
p->p_func = saved_func;
return -1;
}
STATIC int
data_def(p, d)
parse_t *p;
struct_t *d; /* The struct the idents are going into. */
{
object_t *o; /* The value it is initialised with. */
object_t *n; /* The name. */
struct_t *super;
int wasfunc;
int hasinit;
n = NULL;
o = NULL;
wasfunc = 0;
/*
* Work through the list of identifiers being declared.
*/
for (;;)
{
if (next(p, NULL) != T_NAME)
{
error = "syntax error in variable definition";
goto fail;
}
n = p->p_got.t_obj;
/*
* Gather any initialisation or function.
*/
hasinit = 0;
switch (next(p, NULL))
{
case T_EQ:
switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
{
case 0: not_followed_by("ident =", an_expression);
case -1: goto fail;
}
hasinit = 1;
break;
case T_ONROUND:
reject(p);
if (function(p, stringof(n)) < 0)
goto fail;
o = p->p_got.t_obj;
wasfunc = 1;
hasinit = 1;
break;
default:
o = objof(&o_null);
got(o);
reject(p);
}
/*
* Assign to the new variable if it doesn't appear to exist
* or has an explicit initialisation. But patch out the super
* of the struct to get an exact hit on the struct in question.
*/
if ((super = d->s_super) != NULL)
{
got(super);
d->s_super = NULL;
}
if (hasinit || fetch(objof(d), n) == objof(&o_null))
{
if (assign(objof(d), n, o))
{
if ((d->s_super = super) != NULL)
loose(super);
goto fail;
}
}
if ((d->s_super = super) != NULL)
loose(super);
loose(n);
n = NULL;
loose(o);
o = NULL;
if (wasfunc)
return 1;
switch (next(p, NULL))
{
case T_COMMA: continue;
case T_SEMICOLON: return 1;
}
error = "variable definition not followed by \";\" or \",\"";
goto fail;
}
fail:
if (n != NULL)
loose(n);
if (o != NULL)
loose(o);
return -1;
}
STATIC int
compound_statement(p, sw)
parse_t *p;
struct_t *sw;
{
array_t *a;
a = NULL;
if (next(p, NULL) != T_ONCURLY)
{
reject(p);
return 0;
}
++p->p_depth;
if ((a = new_array()) == NULL)
goto fail;
for (;;)
{
switch (statement(p, a, sw, NULL))
{
case -1: goto fail;
case 1: continue;
}
break;
}
if (next(p, a) != T_OFFCURLY)
{
error = "badly formed statement";
goto fail;
}
p->p_got.t_obj = objof(a);
--p->p_depth;
return 1;
fail:
if (a != NULL)
loose(a);
--p->p_depth;
return -1;
}
STATIC void
free_expr(e)
expr_t *e;
{
int i;
if (e == NULL)
return;
for (i = 0; i < nels(e->e_arg); ++i)
free_expr(e->e_arg[i]);
if (e->e_obj != NULL)
loose(e->e_obj);
zfree((char *)e);
}
STATIC int
bracketed_expr(p, ep)
parse_t *p;
expr_t **ep;
{
if (next(p, NULL) != T_ONROUND)
{
reject(p);
return 0;
}
switch (expr(p, ep, t_prec(T_COMMA)))
{
case 0: not_followed_by("(", an_expression);
case -1: return -1;
}
if (next(p, NULL) != T_OFFROUND)
return not_followed_by("( expr", "\")\"");
return 1;
}
STATIC int
primary(p, ep)
parse_t *p;
expr_t **ep;
{
expr_t *e;
array_t *a;
struct_t *d;
set_t *s;
object_t *n;
object_t *o;
*ep = NULL;
if ((e = talloc(expr_t)) == NULL)
return -1;
e->e_arg[0] = NULL;
e->e_arg[1] = NULL;
e->e_obj = NULL;
switch (next(p, NULL))
{
case T_INT:
e->e_what = T_INT;
if ((e->e_obj = objof(new_int(p->p_got.t_int))) == NULL)
goto fail;
break;
case T_FLOAT:
e->e_what = T_FLOAT;
if ((e->e_obj = objof(new_float(p->p_got.t_float))) == NULL)
goto fail;
break;
case T_STRING:
e->e_what = T_STRING;
o = p->p_got.t_obj;
while (next(p, NULL) == T_STRING)
{
register int i;
i = stringof(p->p_got.t_obj)->s_nchars;
if (chkbuf(stringof(o)->s_nchars + i + 1))
goto fail;
memcpy(buf, stringof(o)->s_chars, stringof(o)->s_nchars);
memcpy
(
buf + stringof(o)->s_nchars,
stringof(p->p_got.t_obj)->s_chars,
i
);
i += stringof(o)->s_nchars;
loose(o);
loose(p->p_got.t_obj);
if ((o = objof(new_name(buf, i))) == NULL)
goto fail;
this = T_NONE;
}
reject(p);
e->e_obj = o;
break;
case T_REGEXP:
e->e_what = T_CONST;
e->e_obj = p->p_got.t_obj;
break;
case T_NAME:
if (p->p_got.t_obj == objof(string_NULL))
{
e->e_what = T_NULL;
loose(p->p_got.t_obj);
break;
}
e->e_what = T_NAME;
e->e_obj = p->p_got.t_obj;
break;
case T_ONROUND:
reject(p);
zfree((char *)e);
e = NULL;
if (bracketed_expr(p, &e) < 1)
goto fail;
break;
case T_ONSQUARE:
if (next(p, NULL) != T_NAME)
{
not_followed_by("[", "an identifier");
goto fail;
}
if (p->p_got.t_obj == objof(string_array))
{
loose(p->p_got.t_obj);
this = T_NONE;
if ((a = new_array()) == NULL)
goto fail;
for (;;)
{
switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
{
case -1: goto fail;
case 1:
if (pushcheck(a, 1))
{
loose(a);
goto fail;
}
*a->a_top++ = o;
loose(o);
if (next(p, NULL) == T_COMMA)
continue;
reject(p);
break;
}
break;
}
if (next(p, NULL) != T_OFFSQUARE)
{
loose(a);
not_followed_by("[array expr, expr ...", "\"]\"");
goto fail;
}
e->e_what = T_CONST;
e->e_obj = objof(a);
}
else if (p->p_got.t_obj == objof(string_struct))
{
struct_t *super;
loose(p->p_got.t_obj);
this = T_NONE;
if ((d = new_struct()) == NULL)
goto fail;
super = NULL;
if (next(p, NULL) == T_COLON)
{
switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
{
case 0: not_followed_by("[struct :", an_expression);
case -1: goto fail;
}
loose(o);
if (!isstruct(o))
{
error = "the struct literal's super is not a struct";
goto fail;
}
super = structof(o);
switch (next(p, NULL))
{
case T_OFFSQUARE:
reject(p);
case T_COMMA:
break;
default:
loose(super);
not_followed_by("[struct : expr", "\",\" or \"]\"");
goto fail;
}
}
else
reject(p);
for (;;)
{
switch (next(p, NULL))
{
case T_OFFSQUARE:
break;
case T_ONROUND:
switch (const_expression(p, &o, t_prec(T_COMMA)))
{
case 0: not_followed_by("[struct ... (", an_expression);
case -1: loose(d); goto fail;
}
if (next(p, NULL) != T_OFFROUND)
{
not_followed_by("[struct ... (expr", "\")\"");
goto fail;
}
n = o;
goto gotkey;
case T_NAME:
n = p->p_got.t_obj;
gotkey:
if (next(p, NULL) != T_EQ)
{
not_followed_by("[struct ... key", "\"=\"");
loose(d);
loose(n);
goto fail;
}
switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
{
case 0: not_followed_by("[struct ... ident =", an_expression);
case -1: goto fail;
}
if (assign(d, n, o))
goto fail;
loose(n);
loose(o);
switch (next(p, NULL))
{
case T_OFFSQUARE:
reject(p);
case T_COMMA:
continue;
}
not_followed_by("[struct ... key = expr", "\",\" or \"]\"");
loose(d);
goto fail;
}
break;
}
if ((d->s_super = super) != NULL)
loose(super);
e->e_what = T_CONST;
e->e_obj = objof(d);
}
else if (p->p_got.t_obj == objof(string_set))
{
loose(p->p_got.t_obj);
this = T_NONE;
if ((s = new_set()) == NULL)
goto fail;
for (;;)
{
switch (const_expression(p, &o, t_prec(T_COMMA) - 1))
{
case -1: goto fail;
case 1:
if (assign(s, o, objof(o_one)))
{
loose(s);
goto fail;
}
loose(o);
if (next(p, NULL) == T_COMMA)
continue;
reject(p);
break;
}
break;
}
if (next(p, NULL) != T_OFFSQUARE)
{
loose(s);
not_followed_by("[set expr, expr ...", "\"]\"");
goto fail;
}
e->e_what = T_CONST;
e->e_obj = objof(s);
}
else if (p->p_got.t_obj == objof(string_func))
{
loose(p->p_got.t_obj);
this = T_NONE;
if ((n = objof(new_cname(""))) == NULL)
goto fail;
switch (function(p, stringof(n)))
{
case 0: not_followed_by("[func", "function body");
case -1:
loose(n);
goto fail;
}
loose(n);
e->e_what = T_CONST;
e->e_obj = p->p_got.t_obj;
if (next(p, NULL) != T_OFFSQUARE)
{
not_followed_by("[func function-body ", "\"]\"");
goto fail;
}
}
else
{
loose(p->p_got.t_obj);
not_followed_by("[", "\"array\", \"struct\", \"set\" or \"func\"");
goto fail;
}
break;
default:
reject(p);
zfree((char *)e);
return 0;
}
*ep = e;
e = NULL;
for (;;)
{
switch (next(p, NULL))
{
case T_ONSQUARE:
if ((e = talloc(expr_t)) == NULL)
goto fail;
e->e_what = T_ONSQUARE;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
*ep = e;
e = NULL;
switch (expr(p, &(*ep)->e_arg[1], t_prec(T_COMMA)))
{
case 0: not_followed_by("[", an_expression);
case -1: goto fail;
}
if (next(p, NULL) != T_OFFSQUARE)
{
not_followed_by("[ expr", "\"]\"");
goto fail;
}
break;
case T_PTR:
case T_DOT:
if ((e = talloc(expr_t)) == NULL)
goto fail;
e->e_what = this;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
*ep = e;
e = NULL;
switch (next(p, NULL))
{
case T_NAME:
if ((e = talloc(expr_t)) == NULL)
goto fail;
e->e_what = T_STRING;
e->e_arg[0] = NULL;
e->e_arg[1] = NULL;
e->e_obj = NULL;
e->e_obj = p->p_got.t_obj;
(*ep)->e_arg[1] = e;
e = NULL;
break;
case T_ONROUND:
reject(p);
if (bracketed_expr(p, &(*ep)->e_arg[1]) < 1)
goto fail;
break;
default:
not_followed_by(".", "an identifier or \"(\"");
goto fail;
}
break;
case T_ONROUND: /* Function call. */
if ((e = talloc(expr_t)) == NULL)
goto fail;
e->e_what = T_ONROUND;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
*ep = e;
e = NULL;
for (;;)
{
expr_t *e1;
e1 = NULL;
switch (expr(p, &e1, t_prec(T_COMMA) - 1))
{
case -1:
goto fail;
case 1:
if ((e = talloc(expr_t)) == NULL)
goto fail;
e->e_arg[1] = (*ep)->e_arg[1];
(*ep)->e_arg[1] = e;
e->e_what = T_COMMA;
e->e_arg[0] = e1;
e->e_obj = NULL;
e = NULL;
if (next(p, NULL) == T_COMMA)
continue;
reject(p);
break;
}
break;
}
if (next(p, NULL) != T_OFFROUND)
{
error = "error in function call arguments";
goto fail;
}
if (next(p, NULL) == T_ONCURLY)
{
/*
* Gratuitous check to get a better error message.
*/
error = "function definition without a storage class";
goto fail;
}
reject(p);
break;
default:
reject(p);
return 1;
}
}
fail:
if (e != NULL)
{
if (e->e_obj != NULL)
loose(e->e_obj);
zfree((char *)e);
}
free_expr(*ep);
*ep = NULL;
return -1;
}
STATIC int
unary(p, ep)
parse_t *p;
expr_t **ep;
{
expr_t *e;
int what;
switch (next(p, NULL))
{
case T_ASTERIX:
case T_AND:
case T_MINUS:
case T_PLUS:
case T_EXCLAM:
case T_TILDE:
case T_PLUSPLUS:
case T_MINUSMINUS:
case T_AT:
case T_DOLLAR:
what = this;
switch (unary(p, ep))
{
case 0: error = "badly formed expression";
case -1: return -1;
}
if ((e = talloc(expr_t)) == NULL)
return -1;
e->e_what = what;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
*ep = e;
break;
default:
reject(p);
switch (primary(p, ep))
{
case 0: return 0;
case -1: return -1;
}
}
switch (next(p, NULL))
{
case T_PLUSPLUS:
case T_MINUSMINUS:
if ((e = talloc(expr_t)) == NULL)
return -1;
e->e_what = this;
e->e_arg[0] = NULL;
e->e_arg[1] = *ep;
e->e_obj = NULL;
*ep = e;
break;
default:
reject(p);
break;
}
return 1;
}
/*
* Parse an expression in the parse context 'p' and store the expression
* tree of 'expr_t' type nodes under the pointer indicated by 'ep'. All
* operators must be of precedence less than or equal to 'prec' (used to
* exclude comma operators in argument lists etc). Usual parseing return
* conventions (see comment near start of file).
*/
STATIC int
expr(p, ep, prec)
parse_t *p;
expr_t **ep;
int prec;
{
expr_t *e;
expr_t **ebase;
expr_t *elimit;
int tp;
int r;
/*
* This expression tree parser is neither state stack based nor recursive
* descent. It maintains an epression tree, and re-forms it each time
* it finds a subsequent binary operator and following factor. In
* practice this is probably faster than either the other two methods.
* It handles all the precedence and right/left associativity and
* the ? : operator correctly (at least according to ICI's definition
* of ? :).
*/
/*
* Get the first factor.
*/
if ((r = unary(p, ebase = ep)) <= 0)
return r;
elimit = *ebase;
/*
* While there is a following binary operator, merge it and the
* following factor into the expression.
*/
while (t_type(next(p, NULL)) == T_BINOP && (tp = t_prec(this)) <= prec)
{
if (this == T_COLON)
{
/*
* Only allow colon after a ? so case labels terminate normally.
*/
for (ep = ebase; (e = *ep) != elimit; ep = &e->e_arg[1])
{
if (e->e_what == T_QUESTION)
goto colon_is_ok_here;
}
break;
colon_is_ok_here:;
}
/*
* Cause assignments to be right associative.
*/
if (tp == t_prec(T_EQ))
--tp;
/*
* Slide down the right hand side of the tree to find where this
* operator binds.
*/
for
(
ep = ebase;
(e = *ep) != elimit && tp < t_prec(e->e_what);
ep = &e->e_arg[1]
)
;
/*
* Allocate a new node and rebuild this bit with the new operator
* and the following factor.
*/
if ((e = talloc(expr_t)) == NULL)
{
zfree((char *)e);
return -1;
}
e->e_what = this;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
switch (unary(p, &e->e_arg[1]))
{
case 0:
sprintf(buf, "\"expr %s\" %s %s",
ici_binop_name(t_subtype(e->e_what)), not_by, an_expression);
error = buf;
case -1:
zfree((char *)e);
return -1;
}
*ep = e;
elimit = e->e_arg[1];
}
reject(p);
return 1;
}
#ifdef NOTDEF
/*
* This code has been replaced by the function above. Which is more
* optimal, just as simple and functionally equivalent.
*/
STATIC int
expr(p, ep, prec)
parse_t *p;
expr_t **ep;
int prec;
{
int r;
expr_t *e;
/*
* This expression parseing is a bit nasty because it recursivly
* climbs up and down all the precedence levels for every primary
* expression. It could be changed to skip around more optimally.
* Mind you, it's probably the smallest C expression parser you
* have ever seen. It handles all the precedence and right/left
* associativity and the ? : operator correctly.
*/
if (prec < 0)
return unary(p, ep);
/*
* T_QUESTION stuff in 2nd arg invalidates colon in normal positions.
* You need this because in 'case' statements colon must terminate
* the expression.
*/
if ((r = expr(p, ep, prec - 1 - (prec == t_prec(T_QUESTION)))) < 1)
return r;
for (;;)
{
if (t_type(next(p, NULL)) != T_BINOP || t_prec(this) != prec)
{
reject(p);
return 1;
}
if ((e = talloc(expr_t)) == NULL)
{
free_expr(*ep);
return -1;
}
e->e_what = this;
e->e_arg[0] = *ep;
e->e_arg[1] = NULL;
e->e_obj = NULL;
*ep = e;
/*
* The t_prec() stuff in 2nd argument causes right associativity.
* (The assignment and question-colon operators are right associative,
* everything else is left.)
*/
r = this;
switch (expr(p, &e->e_arg[1], prec - (t_prec(this) != t_prec(T_EQ)
+ 2 * (t_prec(this) == t_prec(T_COLON)))))
{
case 0:
sprintf(buf, "\"expr %s\" %s %s",
ici_binop_name(t_subtype(r)), not_by, an_expression);
error = buf;
case -1:
return -1;
}
}
}
#endif
STATIC int
expression(p, a, why, prec)
parse_t *p;
array_t *a;
int why;
int prec;
{
expr_t *e;
e = NULL;
switch (expr(p, &e, prec))
{
case 0: return 0;
case -1: goto fail;
}
if (compile_expr(a, e, why) == -1)
goto fail;
free_expr(e);
return 1;
fail:
free_expr(e);
return -1;
}
STATIC int
const_expression(p, po, prec)
parse_t *p;
object_t **po;
int prec;
{
expr_t *e;
array_t *a;
int ret;
a = NULL;
e = NULL;
if ((ret = expr(p, &e, prec)) <= 0)
return ret;
if ((a = new_array()) == NULL)
goto fail;
if (compile_expr(a, e, FOR_VALUE) == -1)
goto fail;
free_expr(e);
e = NULL;
if ((*po = ici_evaluate(objof(a), NULL)) == NULL)
goto fail;
loose(a);
return 1;
fail:
if (a != NULL)
loose(a);
free_expr(e);
return -1;
}
STATIC int
xx_brac_expr_brac(p, a, xx)
parse_t *p;
array_t *a;
char *xx;
{
if (next(p, a) != T_ONROUND)
{
sprintf(buf, "\"%s\" %s a \"(\"", xx, not_by);
goto fail;
}
switch (expression(p, a, FOR_VALUE, t_prec(T_COMMA)))
{
case 0:
sprintf(buf, "\"%s (\" %s %s", xx, not_by, an_expression);
goto fail;
case -1:
return -1;
}
if (next(p, a) != T_OFFROUND)
{
sprintf(buf, "\"%s (expr\" %s \")\"", xx, not_by);
goto fail;
}
return 1;
fail:
error = buf;
return -1;
}
STATIC int
statement(p, a, sw, m)
parse_t *p;
array_t *a; /* Code array being appended to. */
struct_t *sw; /* Switch structure, else NULL. */
char *m; /* Who needs it, else NULL. */
{
array_t *a1;
array_t *a2;
object_t **op;
expr_t *e;
struct_t *d;
object_t *o;
int_t *i;
int stepz;
switch (next(p, a))
{
case T_ONCURLY:
reject(p);
if (compound_statement(p, NULL) == -1)
return -1;
a1 = arrayof(p->p_got.t_obj);
/*
* Perhaps we shouldn't expand the statement in-line like this.
* People may want to be able to take advantage of the sharing
* that might otherwise happen.
*/
if (pushcheck(a, a1->a_top - a1->a_base))
return -1;
for (op = a1->a_base; op < a1->a_top; ++op)
*a->a_top++ = *op;
loose(a1);
break;
case T_SEMICOLON:
break;
case T_OFFCURLY: /* Just to prevent unecessary expression parseing. */
case T_EOF:
case T_ERROR:
reject(p);
goto none;
case T_NAME:
if (p->p_got.t_obj == objof(string_extern))
{
loose(p->p_got.t_obj);
if
(
(d = structof(v_top[-1])->s_super) == NULL
||
(d = d->s_super) == NULL
)
{
error = "extern declaration, but no extern variable scope";
return -1;
}
goto decl;
}
if (p->p_got.t_obj == objof(string_static))
{
loose(p->p_got.t_obj);
if ((d = structof(v_top[-1])->s_super) == NULL)
{
error = "static declaration, but no static variable scope";
return -1;
}
goto decl;
}
if (p->p_got.t_obj == objof(string_auto))
{
loose(p->p_got.t_obj);
if (p->p_func == NULL)
d = structof(v_top[-1]);
else
d = p->p_func->f_autos;
decl:
if (data_def(p, d) == -1)
return -1;
break;
}
if (p->p_got.t_obj == objof(string_case))
{
loose(p->p_got.t_obj);
if (sw == NULL)
{
error = "\"case\" not at top level of switch body";
return -1;
}
switch (const_expression(p, &o, t_prec(T_COMMA)))
{
case 0: not_followed_by("case", an_expression);
case -1: return -1;
}
if ((i = new_int((long)(a->a_top - a->a_base))) == NULL)
{
loose(o);
return -1;
}
if (assign(sw, o, i))
{
loose(i);
loose(o);
return -1;
}
loose(i);
loose(o);
if (next(p, a) != T_COLON)
return not_followed_by("case expr", "\":\"");
break;
}
if (p->p_got.t_obj == objof(string_default))
{
loose(p->p_got.t_obj);
if (sw == NULL)
{
error = "\"default\" not at top level of switch body";
return -1;
}
if (next(p, a) != T_COLON)
return not_followed_by("default", "\":\"");
if ((i = new_int((long)(a->a_top - a->a_base))) == NULL)
return -1;
if (assign(sw, objof(&o_mark), i))
{
loose(i);
return -1;
}
loose(i);
break;
}
if (p->p_got.t_obj == objof(string_if))
{
loose(p->p_got.t_obj);
if (xx_brac_expr_brac(p, a, "if") != 1)
return -1;
if ((a1 = new_array()) == NULL)
return -1;
if (statement(p, a1, NULL, "if (expr)") == -1)
{
loose(a1);
return -1;
}
a2 = NULL;
if (next(p, a) == T_NAME && p->p_got.t_obj == objof(string_else))
{
loose(p->p_got.t_obj);
if ((a2 = new_array()) == NULL)
return -1;
if (statement(p, a2, NULL, "if (expr) stmt else") == -1)
return -1;
}
else
reject(p);
if (pushcheck(a, 3))
return -1;
*a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
loose(a1);
if (a2 != NULL)
{
*a->a_top++ = objof(a2 = (array_t *)atom(objof(a2), 1));
loose(a2);
*a->a_top++ = objof(&o_ifelse);
}
else
*a->a_top++ = objof(&o_if);
break;
}
if (p->p_got.t_obj == objof(string_while))
{
loose(p->p_got.t_obj);
if ((a1 = new_array()) == NULL)
return -1;
if (xx_brac_expr_brac(p, a1, "while") != 1)
{
loose(a1);
return -1;
}
if (pushcheck(a1, 1))
{
loose(a1);
return -1;
}
/*### Up to here in checking loose() use. */
*a1->a_top++ = objof(&o_ifnotbreak);
if (statement(p, a1, NULL, "while (expr)") == -1)
return -1;
if (pushcheck(a, 2))
return -1;
*a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
loose(a1);
*a->a_top++ = objof(&o_loop);
break;
}
if (p->p_got.t_obj == objof(string_do))
{
loose(p->p_got.t_obj);
if ((a1 = new_array()) == NULL)
return -1;
if (statement(p, a1, NULL, "do") == -1)
return -1;
if (next(p, a1) != T_NAME || p->p_got.t_obj != objof(string_while))
return not_followed_by("do statement", "\"while\"");
loose(p->p_got.t_obj);
if (next(p, NULL) != T_ONROUND)
return not_followed_by("do statement while", "\"(\"");
switch (expression(p, a1, FOR_VALUE, t_prec(T_COMMA)))
{
case 0: error = "syntax error";
case -1: loose(a1); return -1;
}
if (next(p, a1) != T_OFFROUND || next(p, NULL) != T_SEMICOLON)
{
loose(a1);
return not_followed_by("do statement while (expr", "\");\"");
}
if (pushcheck(a1, 1))
return -1;
*a1->a_top++ = objof(&o_ifnotbreak);
if (pushcheck(a, 2))
return -1;
*a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
loose(a1);
*a->a_top++ = objof(&o_loop);
break;
}
if (p->p_got.t_obj == objof(string_forall))
{
loose(p->p_got.t_obj);
if (next(p, a) != T_ONROUND)
return not_followed_by("forall", "\"(\"");
if (expression(p, a, FOR_LVALUE, t_prec(T_COMMA) - 1) == -1)
return -1;
if (next(p, a) == T_COMMA)
{
if (expression(p, a, FOR_LVALUE, t_prec(T_COMMA) - 1) == -1)
return -1;
if (next(p, a) != T_NAME || p->p_got.t_obj != objof(string_in))
return not_followed_by("forall (expr, expr", "\"in\"");
loose(p->p_got.t_obj);
}
else
{
if (this != T_NAME || p->p_got.t_obj != objof(string_in))
return not_followed_by("forall (expr", "\",\" or \"in\"");
loose(p->p_got.t_obj);
if (pushcheck(a, 2))
return -1;
*a->a_top++ = objof(&o_null);
*a->a_top++ = objof(&o_null);
}
if (expression(p, a, FOR_VALUE, t_prec(T_COMMA)) == -1)
return -1;
if (next(p, a) != T_OFFROUND)
return not_followed_by("forall (expr [, expr] in expr", "\")\"");
if ((a1 = new_array()) == NULL)
return -1;
if (statement(p, a1, NULL, "forall (expr [, expr] in expr)") == -1)
return -1;
if (pushcheck(a, 2))
return -1;
*a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
loose(a1);
if ((*a->a_top = objof(new_op(op_forall, 0, 0))) == NULL)
return -1;
loose(*a->a_top);
++a->a_top;
break;
}
if (p->p_got.t_obj == objof(string_for))
{
loose(p->p_got.t_obj);
if (next(p, a) != T_ONROUND)
return not_followed_by("for", "\"(\"");
if (expression(p, a, FOR_EFFECT, t_prec(T_COMMA)) == -1)
return -1;
if (next(p, a) != T_SEMICOLON)
return not_followed_by("for (expr", "\";\"");
/*
* Get the condition expression, but don't generate code yet.
*/
e = NULL;
if (expr(p, &e, t_prec(T_COMMA)) == -1)
return -1;
if (next(p, a) != T_SEMICOLON)
return not_followed_by("for (expr; expr", "\";\"");
/*
* a1 is the body of the loop. Get the step expression.
*/
if ((a1 = new_array()) == NULL)
return -1;
if (expression(p, a1, FOR_EFFECT, t_prec(T_COMMA)) == -1)
return -1;
stepz = a1->a_top - a1->a_base;
if (e != NULL)
{
/*
* Now compile in the test expression.
*/
if (compile_expr(a1, e, FOR_VALUE) == -1)
{
free_expr(e);
return -1;
}
free_expr(e);
if (pushcheck(a1, 1))
return -1;
*a1->a_top++ = objof(&o_ifnotbreak);
}
if (next(p, a1) != T_OFFROUND)
return not_followed_by("for (expr; expr; expr", "\")\"");
if (statement(p, a1, NULL, "for (expr; expr; expr)") == -1)
return -1;
if (pushcheck(a, 2))
return -1;
*a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
loose(a1);
if ((*a->a_top = objof(new_op(op_for, 0, stepz))) == NULL)
return -1;
loose(*a->a_top);
++a->a_top;
break;
}
if (p->p_got.t_obj == objof(string_switch))
{
loose(p->p_got.t_obj);
if (xx_brac_expr_brac(p, a, "switch") != 1)
return -1;
if ((d = new_struct()) == NULL)
return -1;
switch (compound_statement(p, d))
{
case 0: not_followed_by("switch (expr)", "a compound statement");
case -1: return -1;
}
if (pushcheck(a, 3))
return -1;
*a->a_top++ = p->p_got.t_obj;
loose(p->p_got.t_obj);
*a->a_top++ = objof(d = (struct_t *)atom(objof(d), 1));
*a->a_top++ = objof(&o_switch);
loose(d);
break;
}
if (p->p_got.t_obj == objof(string_break))
{
loose(p->p_got.t_obj);
if (next(p, a) != T_SEMICOLON)
return not_followed_by("break", "\";\"");
if (pushcheck(a, 1))
return -1;
*a->a_top++ = objof(&o_break);
break;
}
if (p->p_got.t_obj == objof(string_continue))
{
loose(p->p_got.t_obj);
if (next(p, a) != T_SEMICOLON)
return not_followed_by("continue", "\";\"");
if (pushcheck(a, 1))
return -1;
*a->a_top++ = objof(&o_continue);
break;
}
if (p->p_got.t_obj == objof(string_return))
{
loose(p->p_got.t_obj);
switch (expression(p, a, FOR_VALUE, t_prec(T_COMMA)))
{
case -1: return -1;
case 0:
if (pushcheck(a, 1))
return -1;
if ((*a->a_top = objof(&o_null)) == NULL)
return -1;
++a->a_top;
}
if (next(p, a) != T_SEMICOLON)
return not_followed_by("return [expr]", "\";\"");
if (pushcheck(a, 1))
return -1;
*a->a_top++ = objof(&o_return);
break;
}
if (p->p_got.t_obj == objof(string_try))
{
loose(p->p_got.t_obj);
if ((a1 = new_array()) == NULL)
return -1;
if (statement(p, a1, NULL, "try") == -1)
return -1;
if (next(p, a1) != T_NAME || p->p_got.t_obj != objof(string_onerror))
return not_followed_by("try statement", "\"onerror\"");
loose(p->p_got.t_obj);
if ((a2 = new_array()) == NULL)
return -1;
if (statement(p, a2, NULL, "try statement onerror") == -1)
return -1;
if (pushcheck(a, 3))
return -1;
*a->a_top++ = objof(a1);
*a->a_top++ = objof(a2);
*a->a_top++ = objof(&o_onerror);
loose(a1);
loose(a2);
break;
}
default:
reject(p);
switch (expression(p, a, FOR_EFFECT, t_prec(T_COMMA)))
{
case 0: goto none;
case -1: return -1;
}
if (next(p, a) != T_SEMICOLON)
{
error = "badly formed expression, or missing \";\"";
return -1;
}
break;
}
return 1;
none:
if (m != NULL)
{
sprintf(buf, "\"%s\" %s a reasonable statement", m, not_by);
return -1;
}
return 0;
}
int
parse_module(f, s)
file_t *f;
struct_t *s; /* Scope; autos, statics, externs. */
{
parse_t *p;
object_t *o;
if ((p = new_parse(f)) == NULL)
return -1;
*v_top++ = objof(s);
NEXT_VSVER;
if ((o = ici_evaluate(objof(p), NULL)) == NULL)
{
--v_top;
NEXT_VSVER;
loose(p);
return -1;
}
--v_top;
NEXT_VSVER;
loose(o);
loose(p);
return 0;
}
/*
* Parse the given file, module file name 'mname'. Return 0 if ok, else -1,
* usual conventions. It closes the file (if all goes well).
*/
int
parse_file(mname, file, ftype)
char *mname;
char *file;
ftype_t *ftype;
{
struct_t *s; /* Statics. */
struct_t *a; /* Autos. */
file_t *f;
a = NULL;
f = NULL;
if ((f = new_file(file, ftype, get_cname(mname))) == NULL)
goto fail;
if ((a = new_struct()) == NULL)
goto fail;
if ((a->s_super = s = new_struct()) == NULL)
goto fail;
loose(s);
s->s_super = structof(v_top[-1])->s_super;
if (parse_module(f, a) < 0)
goto fail;
f_close(f);
loose(a);
loose(f);
return 0;
fail:
if (f != NULL)
loose(f);
if (a != NULL)
loose(a);
return -1;
}
STATIC long
mark_parse(p)
register parse_t *p;
{
long mem;
objof(p)->o_flags |= O_MARK;
mem = sizeof(parse_t);
if (p->p_func != NULL)
mem += mark(p->p_func);
if (p->p_file != NULL)
mem += mark(p->p_file);
return mem;
}
int
parse_exec()
{
parse_t *p;
array_t *a;
if ((a = new_array()) == NULL)
return 1;
p = parseof(x_top[-1]);
for (;;)
{
switch (statement(p, a, NULL, NULL))
{
case 1:
if (a->a_top == a->a_base)
continue;
if ((*x_top = objof(new_pc(a))) == NULL)
{
loose(a);
return 1;
}
++x_top;
loose(a);
return 0;
case 0:
if (next(p, a) == T_EOF)
{
--x_top;
loose(a);
return 0;
}
error = "syntax error";
default:
loose(a);
if (this == T_ERROR)
error = p->p_got.t_str;
expand_error(p->p_lineno, p->p_file->f_name);
return 1;
}
}
}
parse_t *
new_parse(f)
file_t *f;
{
register parse_t *p;
if ((p = (parse_t *)talloc(parse_t)) == NULL)
return NULL;
memset(p, 0, sizeof(parse_t));
objof(p)->o_type = &parse_type;
objof(p)->o_tcode = TC_PARSE;
objof(p)->o_flags = 0;
objof(p)->o_nrefs = 1;
rego(p);
p->p_file = f;
p->p_sol = 1;
p->p_lineno = 1;
p->p_func = NULL;
p->p_ungot.t_what = T_NONE;
return p;
}
type_t parse_type =
{
mark_parse,
free_simple,
hash_unique,
cmp_unique,
copy_simple,
assign_simple,
fetch_simple,
"parse"
};